home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gsdbloo.exe / GS_SCRN.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-24  |  7KB  |  283 lines
  1. unit GS_Scrn;
  2. {-----------------------------------------------------------------------------
  3.                            Screen Handler Routines
  4.  
  5.        GS_Scrn Copyright (c)  Richard F. Griffin
  6.  
  7.        20 February 1992
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the objects for all screen display operations.
  14.  
  15.    Changes:
  16.  
  17. ------------------------------------------------------------------------------}
  18.  
  19. interface
  20. {$D-}
  21.  
  22. uses
  23.     Crt,
  24.     Dos;
  25.  
  26. Type
  27.    GS_Scrn_Str80  =  string[80];
  28.  
  29. var
  30.    GS_Scrn_ScB : Boolean;
  31.    GS_Scrn_Segmt : word;
  32.    GS_Scrn_Mode  : integer;
  33.  
  34.  
  35. procedure GS_Scrn_Await_Key;
  36.  
  37. procedure GS_Scrn_Get_Win(x1,y1,x2,y2 : integer;var HS);
  38.  
  39. procedure GS_Scrn_Put_Win(x1,y1,x2,y2 : integer; var HS);
  40.  
  41. procedure GS_Scrn_Put_Atr(cx,cy,bx,by,f,b : integer);
  42.  
  43. procedure GS_Scrn_Put_Char(cx,cy : integer; ch : char);
  44.  
  45. {procedure GS_Scrn_Swap_Char(cx,cy : integer; ch : char);}
  46.  
  47. Procedure GS_Scrn_SetCursor(c : boolean);
  48.                                       {Sets big cursor if argument is true;}
  49.                                       {Sets small cursor if false}
  50. Procedure GS_Scrn_HideCursor;
  51. Procedure GS_Scrn_ShowCursor;
  52.  
  53. implementation
  54.  
  55. type
  56.    stype = array [1..25,1..80] of word;
  57.  
  58. var
  59.    Scrn_p : ^stype;
  60.    reg    : Registers;
  61. {.pa}
  62. {
  63.          ┌──────────────────────────────────────────────────────────┐
  64.          │  ********     Screen Cursor Size Routines      *******   │
  65.          │                                                          │
  66.          │  The next three routines are used to change the size of  │
  67.          │  the screen cursor to indicate whether insert is on or   │
  68.          │  off.  BIOS calls are used.                              │
  69.          └──────────────────────────────────────────────────────────┘
  70. }
  71.  
  72. PROCEDURE LineCursor;                 {Set cursor to two lines}
  73. BEGIN
  74.    reg.ah := $03;                     {Service 3 }
  75.    INTR($10,reg);                     {Intr 10. Get scan lines}
  76.    reg.ah := $01;                     {Service 1 }
  77.    reg.ch := reg.cl-1;                {Set two line difference }
  78.    INTR($10,reg);                     {Interrupt 10.  Set scan lines}
  79. END;
  80.  
  81. PROCEDURE BigCursor;                  {Set cursor to four lines}
  82. BEGIN
  83.    reg.ah := $03;                     {Service 3 }
  84.    INTR($10,reg);                     {Intr 10. Get scan lines}
  85.    reg.ah := $01;                     {Service 1 }
  86.    reg.ch := reg.cl - 3;              {Set four scan lines for cursor}
  87.    INTR($10,reg);                     {Interrupt 10.  Set scan lines }
  88. END;
  89.  
  90. procedure GS_Scrn_SetCursor(c : boolean);
  91.                                       {Sets big cursor if argument is true;}
  92.                                       {sets small cursor otherwise.}
  93. begin
  94.    if c then BigCursor else LineCursor;
  95. end;
  96.  
  97. PROCEDURE GS_Scrn_HideCursor;
  98. BEGIN
  99.    reg.ah := $03;                 { Service 3 }
  100.    INTR($10,reg);                 { Intr 10. Get scan lines}
  101.    reg.cx := reg.cx OR $2000;     { Set bit 5 to 1}
  102.    reg.ah := $01;                 { Service 1 }
  103.    INTR($10,reg);                 { Intr 10 resets cursor}
  104. END;
  105.  
  106. PROCEDURE GS_Scrn_ShowCursor;
  107. BEGIN
  108.    reg.ah := $03;               { Service 3 }
  109.    INTR($10,reg);               { Intr 10. Get scan lines}
  110.    reg.cx := reg.cx AND $DFFF;  { Set bit 5 to 0}
  111.    reg.ah := $01;               { Service 1 }
  112.    INTR($10,reg);               { Intr 10 resets cursor}
  113. END;
  114.  
  115.  
  116. procedure GS_Scrn_Put_Char(cx,cy : integer; ch : char);
  117. var
  118.    valu : word;
  119. BEGIN
  120.    valu := (TextAttr shl 8) + byte(ch);
  121.    scrn_p^[cy,cx] := valu;
  122. END;
  123.  
  124. procedure GS_Scrn_Swap_Char(cx,cy : integer; ch : char);
  125. var
  126.    valu,
  127.    hold : word;
  128. BEGIN
  129.    valu := (TextAttr shl 8) + byte(ch);
  130.    hold := scrn_p^[cy,cx];
  131.    scrn_p^[cy,cx] := valu;
  132.    scrn_p^[cy,cx+1] := hold;
  133. END;
  134.  
  135.  
  136.  
  137.  
  138.  
  139. procedure GS_Scrn_Await_Key;
  140. var
  141.    wsmin,
  142.    wsmax     : word;
  143.    wscx,
  144.    wscy,
  145.    wsattr    : byte;
  146.    ch        : char;
  147.    Scrn      : Array [1..4000] of byte;
  148.    lopx,
  149.    lopy      : integer;
  150.    hour,
  151.    minute,
  152.    second,
  153.    sec100,
  154.    minhold   : word;
  155.  
  156. begin
  157.    GetTime(hour,minute,second,sec100);
  158.    minhold := minute + 5;
  159.    if minhold > 59 then minhold := minhold - 59;
  160.    while minute <> minhold do
  161.    begin
  162.       if KeyPressed then exit;
  163.       GetTime(hour,minute,second,sec100);
  164.    end;
  165.    Randomize;
  166.    move(mem[GS_Scrn_Segmt:0], scrn, 4000);
  167.    wsmin := WindMin;
  168.    wsmax := WindMax;
  169.    wsattr := TextAttr;
  170.    wscx := wherex;
  171.    wscy := wherey;
  172.    window (1,1,80,25);
  173.    TextColor(LightGray);
  174.    TextBackground(Black);
  175.    lopx := 37;
  176.    lopy := 17;
  177.    ClrScr;
  178.    gotoxy(lopx, lopy);
  179.    write('Press Any Key to Start');
  180.    while not KeyPressed do
  181.    begin
  182.       GetTime(hour,minute,second,sec100);
  183.       if minute <> minhold then
  184.       begin
  185.          minhold := minute;
  186.          lopx := random(56) + 1;
  187.          lopy := random(23) + 1;
  188.          ClrScr;
  189.          gotoxy(lopx, lopy);
  190.          write('Press Any Key to Start');
  191.       end;
  192.    end;
  193.    ch := ReadKey;
  194.    if ch = #0 then ch := ReadKey;
  195.    move(scrn, mem[GS_Scrn_Segmt:0], 4000);
  196.    WindMin := wsmin;
  197.    WindMax := wsmax;
  198.    TextAttr := wsattr;
  199.    gotoxy(wscx,wscy);
  200. end;
  201.  
  202.  
  203. procedure GS_Scrn_Get_Win(x1,y1,x2,y2 : integer; var HS);
  204. var
  205.    i,j,x,y  : integer;
  206.    HoldStr : array [1..2000] of word absolute HS;
  207. begin
  208.    i := 0;
  209.    for y := y1 to y2 do
  210.    begin
  211.       for x := x1 to x2 do
  212.       begin
  213.          inc(i);
  214.          HoldStr[i] := scrn_p^[y,x];
  215.       end;
  216.    end;
  217. end;
  218.  
  219. procedure GS_Scrn_Put_Win(x1,y1,x2,y2 : integer; var HS);
  220. var
  221.    i,j,x,y  : integer;
  222.    HoldStr : array [1..2000] of word absolute HS;
  223. begin
  224.    i := 0;
  225.    for y := y1 to y2 do
  226.    begin
  227.       for x := x1 to x2 do
  228.       begin
  229.          inc(i);
  230.          scrn_p^[y,x] := HoldStr[i];
  231.       end;
  232.    end;
  233. end;
  234.  
  235. procedure GS_Scrn_Put_Atr(cx,cy,bx,by,f,b : integer);
  236. var
  237.    i,j,x,y : integer;
  238.    x1, y1, x2, y2  : word;
  239.    c,v,t,g : word;
  240. begin
  241.    if f > 15 then v := 128 else v := 0;
  242.    t := f mod 16;
  243.    g := b mod 8;
  244.    c := (g shl 4) + t + v;
  245.    c := c shl 8;
  246.    x1 := cx + lo(WindMin);
  247.    y1 := cy + hi(WindMin);
  248.    x2 := bx + lo(WindMin);
  249.    y2 := by + hi(WindMin);
  250.    for y := y1 to y2 do
  251.    begin
  252.       for x := x1 to x2 do
  253.       begin
  254.          scrn_p^[y,x] := c + lo(scrn_p^[y,x]);
  255.       end;
  256.    end;
  257. end;
  258.  
  259. function Dos_Mode : integer;
  260. begin
  261.    GS_Scrn_Mode := LastMode;
  262.    if GS_Scrn_Mode = Mono then
  263.    begin
  264.       TextMode(Mono);
  265.       GS_Scrn_Segmt := $B000;
  266.    end
  267.    else
  268.    begin
  269.       TextMode(CO80);
  270.       GS_Scrn_Segmt := $B800;
  271.    end;
  272.    Dos_Mode := GS_Scrn_Mode;
  273. end;
  274.  
  275.  
  276.  
  277. begin
  278.    GS_Scrn_ScB := false;
  279.    GS_Scrn_Mode:= Dos_Mode;
  280.    TextColor(LightGray);
  281.    TextBackGround(Black);
  282.    scrn_p := ptr(GS_Scrn_Segmt,0);
  283. end.